-- card: 4672 from stack: in.3 -- bmap block id: 0 -- flags: 4000 -- background id: 3241 -- name: FileToField ----- HyperTalk script ----- on Install get ChooseTargetStack() InstallResource XCMD,FileToField,it end Install -- part 1 (button) -- low flags: 00 -- high flags: A003 -- rect: left=79 top=300 right=322 bottom=179 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: FileToField ----- HyperTalk script ----- on mouseUp FileToField "card field 1" get the result if it is not empty then put it if "Cancel" is not in it and "Error" is not in it then show card field 1 set the visible of card button 2 to true end if end mouseUp -- part 2 (field) -- low flags: 81 -- high flags: 2007 -- rect: left=265 top=33 right=296 bottom=486 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 0 -- font id: 20 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: FileToField Text -- part 3 (button) -- low flags: 80 -- high flags: A003 -- rect: left=284 top=268 right=290 bottom=458 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Empty and Hide this Field ----- HyperTalk script ----- on mouseUp set lockscreen to true put empty into card field 1 hide card field 1 set the visible of me to false -- doMenu "Compact Stack" set lockscreen to false end mouseUp -- part 6 (field) -- low flags: 81 -- high flags: 2007 -- rect: left=12 top=26 right=298 bottom=491 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 0 -- font id: 22 -- text size: 10 -- style flags: 0 -- line height: 13 -- part name: Source -- part 8 (button) -- low flags: 00 -- high flags: A003 -- rect: left=299 top=300 right=322 bottom=438 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Show Pascal Source ----- HyperTalk script ----- on mouseUp set the visible of card field 2 to not the visible of card field 2 if the visible of card field 2 is true then set the name of me to "Hide Pascal Source" else set the name of me to "Show Pascal Source" end mouseUp -- part contents for background part 16 ----- text ----- FILETOFIELD XCMD version 1.5 Kevin Calhoun The FileToField XCMD copies the contents of a text file into a HyperCard field. You may choose the text file to copy from by selecting it from a standard file dialog box or by specifying its full pathname. If the text file is too large (just under 30K is the practical limit for HyperCard fields), FileToField won't try to copy it into the field. If this or any other error occurs, FileToField will return an error message as the result. Word 1 of this message will be "Error". If the text was copied successfully, FileToField returns the full pathname of the file as the result. INVOKING FILETOFIELD FileToField "fieldDesignation",<"full pathname of file"> You may designate the field into which the text is to be copied in any way considered valid by HyperCard, by number, id, or name, with one exception: you can't use the field's name if it is more than one word. If you do use the field's name, don't put the field name in quotation marks. Nested quotations confuse HyperCard. (See the examples below.) If you don't supply the pathname of the file to be copied from, FileToField will invoke SFGetFile, and the user can select the file from the dialog box. If the user pushes the cancel button of the dialog box, FileToField returns "Cancel" as the Result. examples-- FileToField("card field 1") --these examples copy files chosen from the FileToField("bkgnd field id 16") --standard file dialog into the specified field FileToField("card field Memorex") FileToField "field 5","OldAchesAndPains:Good Stuff:Secrets" --this copies the file "Secrets" into background field 5. REVISION HISTORY 7 March 1988: release of version 1.0 31 March 1988: release of version 1.1 --better reporting of memory errors --more compact code 16 May 1988: release of version 1.2 -- fixed bug that bombed Mac Plus (switched from PBHOpen to FSOpen) 15 March 1989 -- 1.5 -- Altered source code for compatibility with MPW Pascal 3.0. -- part contents for card part 6 ----- text ----- UNIT FileToFieldUnit; { FileToField XCMD © 1988-1989 by the Trustees of Dartmouth College } { Written by Kevin Calhoun } { This source compatible with MPW Pascal 3.0 } (* Pascal FileToField.p Link -m ENTRYPOINT ∂ -o "YourFile" ∂ -rt XCMD=2235 ∂ -sn Main=FileToField ∂ FileToField.p.o ∂ "{Libraries}"interface.o ∂ "{PLibraries}"Paslib.o ∂ "{Libraries}"HyperXLib.o *) {$R-} INTERFACE USES Types, Memory, Files, Resources, Packages, HyperXCmd; PROCEDURE EntryPoint (paramPtr : XCmdPtr); IMPLEMENTATION PROCEDURE FileToField(paramPtr : XCmdPtr); FORWARD; PROCEDURE EntryPoint(paramPtr : XCmdPtr); BEGIN FileToField(paramPtr); END; FUNCTION GetScreenBitsBounds: Rect; { get screenbits.bounds from the QuickDraw globals } TYPE LongwordPtr = ^LONGINT; BitMapPtr = ^BitMap; CONST screenBitsOffset = -122; CurrentA5 = $904; VAR screenBitsPtr : BitMapPtr; myLongwordPtr : LongwordPtr; BEGIN myLongwordPtr := LongwordPtr(CurrentA5); { myLongwordPtr now points to the pointer to the first QD global } myLongwordPtr := LongwordPtr(myLongwordPtr^); { myLongwordPtr now points to the first QD global } screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset); { screenBitsPtr now points to the screenBits BitMap } GetScreenBitsBounds := screenBitsPtr^.bounds; END; FUNCTION BuildThePathname (fName : Str255; vRefNum : INTEGER) : Str255; { Given the "short name" and vRefNum of a file, returns the full pathname. } { This function is adapted from Steve Maller's FileName XFCN published in } { HyperTalk Programming by Dan Shafer, Howard W. Sams & Company, 1988, } { pp. 399-403. } VAR name, fullPathName : Str255; err : INTEGER; myWDPB : WDPBPtr; myCPB : CInfoPBPtr; myPB : HParmBlkPtr; BEGIN fullPathName := ''; { start with an empty pathname } { Allocate some memory in the heap for the parameter block. } myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec))); IF ord4(myCPB) > 0 THEN { continue if mem allocation was OK } BEGIN myWDPB := WDPBPtr(myCPB); myPB := HParmBlkPtr(myCPB); { same pointer, different variations of the record -- see IM IV, p. 117 } name := ''; { start with an empty name for the volume } WITH myPB^ DO BEGIN ioNamePtr := @name; { we want the volume name } ioCompletion := pointer(0); ioVRefNum := vRefNum; { returned by SFGetFile } ioVolIndex := 0; { use the vRefNum and name only to designate volume } END; err := PBHGetVInfo(myPB, FALSE); { fill in the volume info } IF err = noErr THEN BEGIN { Now we need the Working Directory (WD) information because we're } { going to step backwards from the file through all of the folders until } { we reach the root directory. } WITH myWDPB^ DO BEGIN ioVRefNum := vRefNum; { this got set to 0 above } ioWDProcID := 0; { use the vRefNum } ioWDIndex := 0; { we want all directories } END; err := PBGetWDInfo(myWDPB, FALSE); IF err = noErr THEN BEGIN WITH myCPB^ DO BEGIN ioFDirIndex := -1; { use the ioDirID field only } ioDrDirID := myWDPB^.ioWDDirID; { info returned above } END; err := PBGetCatInfo(myCPB, FALSE); IF err = noErr THEN BEGIN { Here starts the real work -- start to climb the tree by continually } { looking in the ioDrParID field for the next directory above until we fail... } myCPB^.ioDrDirID := myCPB^.ioDrParID; { the first folder } fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fName); REPEAT myCPB^.ioDrDirID := myCPB^.ioDrParId; err := PBGetCatInfo(myCPB, FALSE); { the next level } { Be careful of an error returned here -- it means the user chose a file on the } { desktop level of this volume. If this is the case, just stop here and return } { "VolumeName:FileName"; otherwise loop until failure. } IF err = noErr THEN fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fullPathName); UNTIL err <> noErr; END; { if PBGetCatInfo worked OK } END; { if PBGetWDInfo worked OK } END; { if PBHGetVInfo worked OK } DisposPtr(pointer(myCPB)); END; { if we had enough room for a new pointer } BuildThePathname := fullPathName; END; PROCEDURE PassReturnValue (paramPtr : XCMDPtr; theMsg : Str255); { set theResult } BEGIN paramPtr^.returnValue := PasToZero(paramPtr, theMsg); END; PROCEDURE SetField (paramPtr : XCmdPtr; theStringPtr : Ptr; theTextHandle : handle); VAR whichField, theString : Str255; cardFieldFlag : BOOLEAN; matchPtr : Ptr; theResult : Handle; fieldID : INTEGER; BEGIN { get Pascal string that contains designation of field to be printed } ZeroToPas(paramPtr, theStringPtr, whichField); { get long name of this field to see if it's a card or bkgnd field } theResult := EvalExpr(paramPtr, CONCAT('the long name of ', whichField)); IF (paramPtr^.result = noErr) THEN BEGIN MoveHHi(theResult); HLock(theResult); { see if this thing actually is an extant field } { if HC returns a long field name with the word 'card' in it, we'll assume it's real } matchPtr := StringMatch(paramPtr, 'card', theResult^); IF (matchPtr <> NIL) AND (paramPtr^.result = noErr) THEN { this must be a field after all } BEGIN { check to see if name of field contains 'card field' -- so we can set the cardFieldFlag } matchPtr := StringMatch(paramPtr, 'card field', theResult^); cardFieldFlag := (matchPtr <> NIL); { free the space allocated by EvalExpr above } DisposHandle(theResult); { get the id of this field } theResult := EvalExpr(paramPtr, CONCAT('the id of ', whichField)); IF (theResult <> NIL) AND (paramPtr^.result = noErr) THEN BEGIN MoveHHi(theResult); HLock(theResult); { convert it into a string, then into a number } ZeroToPas(paramPtr, theResult^, theString); fieldID := StrToNum(paramPtr, theString); DisposHandle(theResult); { and free the memory allocated by EvalExpr } SetFieldByID(paramPtr, cardFieldFlag, fieldID, theTextHandle); END; { set the contents of the field to the contents of theTextHandle } END; END; IF GetHandleSize(theResult) <> 0 THEN DisposHandle(theResult); END; PROCEDURE FileToField (paramPtr : XCmdPtr); VAR reply : SFReply; { returned by SFGetFile } fileName : Str255; { name of file to open } theVRefNum : INTEGER; { ref num of volume (or directory) on which the file resides } theRefNum : INTEGER; { refNum of file, for file manager calls } err : OSErr; { save error codes for reporting trouble } logEOF : longint; { length of file } theBufHndl : Handle; { for copying contents of file into memory } zeroPtr: Ptr; parameterCount : INTEGER; { the number of parameters passed to us } didSFGet : BOOLEAN; numStr : Str255; PROCEDURE DoSFGet; VAR where : point; typeList : SFTypeList; dlgt: DialogTHndl; r: rect; screen: rect; h, v: INTEGER; BEGIN { select text file to read using SFGetFile } dlgt := DialogTHndl(GetResource('DLOG',getDlgID)); if dlgt <> nil then begin r := dlgt^^.boundsRect; screen := GetScreenBitsBounds; h := ((screen.right - screen.left) - (r.right - r.left)) div 2; v := ((screen.bottom - screen.top) - (r.bottom - r.top)) div 2; SetPt(where, h, v); end else SetPt(where, 82, 75); typeList[0] := 'TEXT'; { tell SFGetFile to display only text files } SFGetFile(where, '', NIL, 1, typeList, NIL, reply); END; FUNCTION GetFileName : Str255; { return the name of the file to copy from } VAR temp : Str255; BEGIN IF parameterCount > 1 THEN BEGIN ZeroToPas(paramPtr, paramPtr^.params[2]^, temp); didSFGet := FALSE; END ELSE BEGIN doSFGet; IF reply.good = TRUE THEN temp := reply.fName ELSE temp := ''; didSFGet := TRUE; END; GetFileName := temp; END; BEGIN parameterCount := paramPtr^.paramCount; IF parameterCount > 0 THEN BEGIN fileName := GetFileName; IF fileName <> '' THEN BEGIN IF didSFGet THEN theVRefNum := reply.vRefNum ELSE theVRefNum := 0; err := FSOpen(fileName, theVRefNum, theRefNum); IF err = noErr THEN BEGIN err := GetEOF(theRefNum, logEOF); IF err = noErr THEN IF logEOF < 29990 THEN { 29990 bytes is my experimental value for the maximum safe size of HC fields } BEGIN theBufHndl := NewHandle(logEOF); err := MemError; IF (theBufHndl <> NIL) AND (err = noErr) THEN BEGIN MoveHHi(theBufHndl); HLock(theBufHndl); err := FSRead(theRefNum, logEOF, theBufHndl^); IF err = noErr THEN BEGIN HUnlock(theBufHndl); SetHandleSize(theBufHndl,logEOF+1); zeroPtr := Ptr(ORD4(theBufHndl^)+logEOF); zeroPtr^ := 0; IF err = noErr THEN BEGIN SetField(paramPtr, paramPtr^.params[1]^, theBufHndl); IF didSFGet THEN fileName := BuildThePathname(fileName, theVRefNum); PassReturnValue(paramPtr, fileName); END; END; DisposHandle(theBufHndl); END { if theBufHndl <> nil } ELSE BEGIN NumToStr(paramPtr, err,numStr); PassReturnValue(paramPtr, CONCAT('Error ', numStr)); END; END { if the file wasn't too big to read in } ELSE PassReturnValue(paramPtr, 'Error (file too big)'); err := FSClose(theRefNum); END; { if err = noErr in opening the file } IF err <> noErr THEN { if we had an error, report it } BEGIN NumToStr(paramPtr, err,numStr); PassReturnValue(ParamPtr, CONCAT('Error ', numStr)); END; END ELSE PassReturnValue(paramPtr, 'Cancel'); END { if we got parameters } ELSE PassReturnValue(paramPtr, 'FileToField XCMD 1.5, 15 March 1989, ©1988-1989 Dartmouth College'); END; END.